perm filename RESPC.F4[PAG,LCS]15 blob sn#513518 filedate 1980-05-26 generic text, type T, neo UTF8
00100		SUBROUTINE RESPC
00200	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
00300		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00400		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00500		1 RCLEF(0/7) /IVV/IV(1)
00600		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00700	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00800		COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00900		1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
01000	C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01100	      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01200		1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01300		INTEGER DUMMY
01400		COMMON /PX/PN(1) /Q/Q(1)
01500		1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01600		1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01700		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
01800		1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
01900		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02000		1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02100		1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02200		1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02300		DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
02400		1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/,ACCISZ/1.0/
02450		1 ,O1/0.01/
02500	C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
02600	
02700		IF(NMPG.NE.'PAGEA')GO TO 2000
02800	C SHOULD HANDLE UP TO 104 INPUT FILES.  ADD HERE AND LATER FOR MORE RANGE.
02900		RNEXT=0
03000	2000	SPCNT=1.0
03100		JX=0
03200		JCEN=0
03300	C  FLAG FOR CENTERED RESTS.
03400		XT=0
03500		JK=1
03600	C JK IS USED AT END.  IN SECTION TO FIND SIZE FACTOR FOR EACH BAR.
03700		PX=0
03800		CALL SHFT1(KQ)
03900		KK=L
04000	CC	TYPE 3001,L
04100	C  DELETES EXTRA BAR LINES, ETC.
04200		IF(IPG)CALL RESTS
04300	C???	IF(N)RETURN 
04400	C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04500	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04600		CALL SHIFT
04700	C  L=NUMBER OF ITEMS FOR RHY RECONS.
04800		JJ2=L+2
04900	C FOR WDCNT IN .PAG FILE
05000		IF(IPG.EQ.2)GO TO 11
05100	C IPG=2=REORDER INPUT FILE ONLY.
05200		N=0
05300		S=-100
05400		R=0
05500		KCLEF=0
05600		NOGRCE=-1
05700	C  GRACE NOTE FLAG
05800		TTT=0
05900	C FOR IRREG. NUMS. OF STAVES.
06000	
06100	C******** BIG LOOP ***************
06200	161	DO 601 K=1,L
06300		R=CODEN(KPN,K,Q,J)
06400		RZ=Q(J)
06500	CX	J=KPN(K)
06600	CC	N=N+1
06700	CC	NN(N)=0
06800	CC	MM(N)=J+3
06900		CALL MMNN(3)
07000		NN(N)=-R
07100	C MAKE ALL CODE NUMS NEG. AT FIRST.  CHANGE 1,2,3,4,17,18 LATER
07200	CX	R=Q(J+1)
07300		IF(R.GT.2)GO TO 1801
07400		IF(Q(J+2).GT.TTT)TTT=Q(J+2)
07500	C FINDS HIGHEST STAFF NUM.  NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07600		IF(R.NE.1)GO TO 2801
07700		IF(RZ.LT.7)GO TO 601
07800		IF(Q(J+9).LE.0)GO TO 601
07900	C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
08000		IF(Q(J+9).NE.4./88.)GO TO 702
08100	CC	IF(Q(J+9).GT..05)GO TO 702
08200	CC	IF(Q(J+8).EQ.1000)GO TO 601
08300	C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
08400		NOGRCE=0
08500		GO TO 601
08600	CCC2801	IF(R.NE.2)GO TO 1801
08700	2801	RS=Q(J+7)
08800		IF(RZ.LT.7)GO TO 3801
08900	C DELETE ALL UP TO LABEL 1801 LATER.  NEW CENTERED REST FEATURE. 5/29/78
09000	CXX	NN(N)=-NN(N)
09100		IF(Q(J+9).NE.0)Q(J+9)=-1
09200	C  SET UP WHOLE REST CENTERING. (P9=-1 CAUSES CENTERING AT OUTPUT TIME.)
09300		IF(Q(J+8).EQ.0)GO TO 601
09400	C SKIP IF WHOLE REST OVER CUE NOTES. (P8=0)
09500		IF(RS.LE.0)GO TO 601
09600	C SKIP RESTS WITH NO RHYTHM VALUE IN P7
09700		GO TO 702
09800	C??? NOW MAKE CODE NUM. POS.
09900	CC	NN(N)=R
10000	CC	GO TO 688
10100	3801	IF(RZ.LT.5)GO TO 601
10200		IF(RS.LE.0)GO TO 601
10300		IF(IPG)GO TO 702
10400		IF(RZ.LT.6)GO TO 702
10500		IF(Q(J+6))GO TO 702
10600	C PARAM 6=-1 = INVISIBLE. SHOULDN'T BE WHOLE REST (P8) ANYWAY.
10700		RS=Q(J+3)
10800	C GET POS. OF CENTERED WHOLE REST
10900		TT=0
11000		B=Q(J+2)
11100	C GET THE STAFF NUM.
11200		DO 602 M=1,L
11300		T=CODEN(KPN,M,Q,JJ)
11400		A=Q(JJ+3)
11500	C GET POS. OF ITEM
11600		IF(A.GT.RS)GO TO 602
11700	C JUMP IF ITEM IS TO RIGHT OF REST
11800		IF(T.NE.4)GO TO 602
11900	C IS THE ITEM A BAR LINE
12000		IF(Q(JJ+4).LT.0)GO TO 602
12100	C**** SKIP IF INVIS. BAR (P4=-1)
12200		IF(A.GT.TT)TT=A
12300	C FINDS BAR LINE CLOSEST TO LEFT OF REST
12400	602	CONTINUE
12500	C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
12600		T=20000
12700		A=20000
12800	C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
12900		DO 613 M=1,L
13000		IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
13100		IF(Q(JJ).LT.7)GO TO 609
13200	C SKIP IF RHYTH NOT IN P9
13300		IF(Q(JJ+9).LT..05)GO TO 613
13400	C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
13500	609	B=Q(JJ+3)
13600	C POS. OF ITEM
13700		X=B-TT
13800		IF(X)GO TO 613
13900	C JUMP IF ITEM IS TOO FAR TO LEFT
14000		IF(X.GT.A)GO TO 613
14100		A=X
14200		T=B
14300	C T = POS OF NOTE OR REST NEAREST BAR, ETC.
14400	613	CONTINUE
14500		IF(T.NE.20000)GO TO 612
14600	C JUMP IF NOTE OR REST FOUND
14700		JCEN=-1
14800		GO TO 1801
14900	612	Q(J+3)=T
15000	C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
15100	C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
15200	C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
15300	1801	IF(R.LT.4)GO TO 702
15400		IF(R.EQ.17)GO TO 1702
15500		IF(R.EQ.18)GO TO 1701
15600		IF(R.EQ.10)GO TO 702
15700	C FOUND A NUMBER.  USE THIS IN RESTP
15800		IF(R.LE.7)GO TO 30
15900		IF(R.NE.44)GO TO 601
16000		IF(RZ.EQ.2)GO TO 601
16100	C RZ=2= BAR LINE ON UPPER STAFF
16200		IF(Q(J+6).EQ.0)GO TO 601
16300		IF(Q(J+5).EQ.0)GO TO 601
16400	C  GETS LEFT END OF LINES, CRESC., DASHES.
16500		GO TO 604
16600	30	IF(R.NE.7)GO TO 605
16700		IF(RZ.LT.5)GO TO 604
16800	C JUMP FOR STANDARD TRILL
16900		RS=Q(J+7)
17000		IF(RS.EQ.1)GO TO 604
17100		IF(ABS(RS).GE.3)GO TO 604
17200	C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
17300		GO TO 601
17400	605	IF(R.NE.4)GO TO 604
17500		IF(Q(J+4).LT.0)GO TO 601
17600	C*** SKIP IF INVIS. BAR (P4=-1)
17700		IF(RZ.LE.3)GO TO 702
17800	C JUMP IF IT IS A BAR LINE
17900	CC	IF(RZ.LT.4)GO TO 601
18000		IF(Q(J+6).NE.0)GO TO 604
18100	C GO GET OTHER POS OF LINE
18200		GO TO 601
18205	1701	IF(NN(N-1).NE.18)GO TO 1702
18207		IF(Q(J+2).EQ.Q(KPN(K-1)+2))Q(J+4)=-8.
18210	C SHIFT METER DOWN  IF PREVIOUS ITEM WAS ALSO METER. (IN SAME POSITION)
18300	1702	IF(Q(J+4).NE.0)GO TO 601
18400		IF(Q(J+2).NE.0)GO TO 601
18500	C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
18600	702	NN(N)=-NN(N)
18700	CC702	NN(N)=R 
18800		GO TO 601
18900	C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
19000	604	CALL MMNN(6)
19100	C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS  (PUTS -1 INTO NN(X))
19200	CCXX	NN(N)=-1
19300	
19400		IF(R.NE.6)GO TO 601
19500	C NEXT FOR BEAMS
19600		IF(RZ.LT.8)GO TO 608
19700		IF(Q(J+10).EQ.0)GO TO 608
19800		IF(Q(J+8))GO TO 608
19900	C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
20000		IF(Q(J+7).GT.0)CALL MMNN(8)
20100	C NEXT SHIFTS P8 OF COMPOSITE BEAMS
20200	608	IF(RZ.LT.7)GO TO 601
20300		IF(Q(J+7))GO TO 688
20400	C  P7 IS NEG FOR TREMOLO
20500		IF(Q(J+8).EQ.0)GO TO 601
20600	C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
20700	688	IF(Q(J+9).GT.0)CALL MMNN(9)
20800	C FOUND A POS. IN P9
20900	601	CONTINUE
21000	
21100		KPG=TTT+1
21200	C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
21300	
21400	C NEXT SORTS THE POINTS
21500	6000	J=1
21600	CC610	IF(NN(J).NE.-16)GO TO 1610
21700	C NEXT LOOKS FOR CONTINUATION OF TEXTS.(P10=1)  PUTS ALL AT SAME P3 LOC.
21800	CC	K=MM(J)
21900	CC	IF(Q(K-3).LT.8)GO TO 1610
22000	CC	IF(Q(K+7).EQ.1)Q(K)=Q(MM(J-1))
22100	CC	GO TO 710
22200	CC1610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22300	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22400		CALL EXCHG(MM(J),NN(J))
22500	C  ABOVE EXCHGS --(J) AND --(J+1)
22600		IF(J.EQ.1)GO TO 710
22700		J=J-1
22800		GO TO 610
22900	710	J=J+1
23000		IF(J.LT.N)GO TO 610
23100	C NOW ALL SORTED
23200		CALL FNDEND(R)
23300		CALL SHFTQ(R)
23400	C  SHIFTS TO PROPER HORIZ. POS.
23500		IF(IPG)CALL RESTP
23600	C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS. (FOR PARTS ONLY)
23700		IF(N.LE.0)GO TO 122
23800	C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.
23900	
24000		DO 119 K=1,150
24100	119	HH(K)=0
24200	C  HH ARRAY WILL HOLD FINAL COMPOSITE.
24300		G(1)=0
24400		E(1)=0
24500		F(1)=0
24600		RN(1500)=0
24700		RN(2500)=0
24800		ST=0
24900	C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
25000	C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
25100		KE=0
25200		J=1000
25300	933	JJ=1500
25400		JJJ=2000
25500		T=0
25600		M=0
25700		A=0
25800		B=0
25900	
26000		DO 33 K=1,N
26100		IF(NORH(KK,K))GO TO 33
26200	CC	KK=NN(K)
26300	CC	IF(KK.EQ.0)GO TO 33
26400	CC	IF(KK.EQ.4)GO TO 2133
26500	CC	IF(KK.EQ.17)GO TO 2133
26600	C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
26700	CC	IF(KK.EQ.18)GO TO 2133
26800	CC	IF(KK.GT.2)GO TO 33
26900	2133	LL=MM(K)-3
27000		IF(KK.LE.2)GO TO 1133
27100		RH=O1
27200	C RHYTHMIC VALUE OF BARLINE, METER, KSIG
27300	CCC	IF(KK.NE.4)RH=.6
27400		GO TO 3133
27500	1133	IF(Q(LL+2).NE.ST)GO TO 33
27600	C JUMP IF NOT ON RIGHT STAFF
27700		RA=9
27800		IF(KK.EQ.2)RA=7
27900		IF(Q(LL).LT.RA-2)GO TO 33
28000	C JUMP IF WDCNT IS TOO SHORT
28100		IF(KK.EQ.1)GO TO 433
28200		IF(Q(LL).LT.6)GO TO 433
28300	C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
28400		RZ=Q(LL+8)
28500	C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
28600		IF(RZ.LE.0)GO TO 433
28700		Q(LL+7)=2
28800	C 2 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST (WAS 3)
28900		IF(RZ.LT.8)GO TO 433
29000		Q(LL+5)=-3
29100	C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
29200		RZ=RZ/2.0
29300	CC	RZ=IFIX(RZ/2.0)+1.0
29400		IF(RZ.GT.6)RZ=6
29500	C LIMIT OF 8 ON RHYTH VAL.
29600		Q(LL+7)=RZ
29700	433	RH=Q(LL+IFIX(RA))
29800		IF(RH.EQ.0)GO TO 33
29900	3133	RZ=Q(LL+3)
30000		IF(ZERO(RZ,A).EQ.0)GO TO 133
30100	C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
30200		RRH=RH
30300	C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
30400		TT=T
30500	C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
30600		J=J+1
30700	C UPDATE COUNTER IN POSITION ARRAY
30800		T=T+RH
30900	C ADD TO TOTAL RHYTHM
31000		RN(J)=T
31100		A=Q(LL+3)
31200	C SAVE POS. OF THIS NOTE.
31300		GO TO 33
31400	133	IF(RH.EQ.RHH)GO TO 33
31500	C  IGNORE 2ND RHYTH IF SAME AS FIRST
31600		IF(ZERO(RZ,B).EQ.0)GO TO 333
31700	C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
31800		TTT=TT
31900	C SAVE TOTAL RHYTHM TO THIS POINT.
32000		TT=TT+RH
32100		JJ=JJ+1
32200	C UPDATE COUNTER FOR 2ND ARRAY
32300		RN(JJ)=TT
32400		RRRH=RH
32500		B=A
32600		GO TO 33
32700	333	IF(RH.EQ.RRRH)GO TO 33
32800		TTT=TTT+RH
32900		JJJ=JJJ+1
33000		RN(JJJ)=TTT
33100	33	CONTINUE
33200	C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
33300		IF(ST.NE.0)GO TO 733
33400		KE=J-999
33500	C TOTAL NUM OF RHYTHMS ON STAFF1.
33600	CC	IF(JPG.EQ.0)GO TO 2233
33700		IF(KPG.LE.1)GO TO 2233
33800	C KPG=0=PARTS;    =1=PAGE, 1 STAFF
33900	C  JUMP IF ONLY ONE STAFF
34000	C****733	KF=J-2499
34100	C KF=NUM OF RHYTHMS ON NEXT STAFF.  **** NEVER USED ****
34200	733	ST=ST+1
34300		IF(ST.GT.1)GO TO 833
34400	C JUMP IF ALL STAVES HAVE BEEN READ.
34500	1233	J=2500
34600		GO TO 933
34700	833	IF(J.NE.2500)GO TO 1533
34800	C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
34900	C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
35000	
35100	2233	CALL RLOOP(HH,E,KE)
35200	C FOR SINGLE STAFF OF RHYTHM
35300		KL=KE
35400		GO TO 1333
35500	1533	K=1
35600		L=1
35700		M=0
35800	19	KK=K
35900		LL=L
36000	1	SM=10000
36100		K=K+1
36200		IF(K.GT.KE)GO TO 10
36300	4	L=L+1
36400		Y=F(L)
36500		B=Y-F(L-1)
36600		IF(B.LT.SM)SM=B
36700	2	X=E(K)
36800		A=X-E(K-1)
36900	C  A AND B HAVE TRUE DURATIONS NOW
37000		IF(A.LT.SM)SM=A
37100	C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
37200		IF(ZERO(X,Y).EQ.0)GO TO 3
37300	C JUMP IF EQUAL RHYTHS
37400		IF(X.GT.Y)GO TO 4
37500		K=K+1
37600	C STEP FORWARD UNTIL X IS .GT. Y
37700		GO TO 2
37800	3	IF(K.NE.KK+1)GO TO 13
37900		IF(L.NE.LL+1)GO TO 14
38000		M=M+1
38100		G(M)=E(KK)
38200		GO TO 19
38300	13	IF(L.NE.LL+1)GO TO 15
38400		DO 16 J=KK,K-1
38500		M=M+1
38600	16	G(M)=E(J)
38700		GO TO 19
38800	14	DO 17 J=LL,L-1
38900		M=M+1
39000	17	G(M)=F(J)
39100		GO TO 19
39200	15	XM=SM-.001
39300		M=M+1
39400		P=E(KK)
39500		G(M)=P
39600	7	KK=KK+1
39700		LL=LL+1
39800		YM=SM*1.5
39900	C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
40000		S=P
40100		T=P
40200	27	A=E(KK)
40300		B=F(LL)
40400		IF(ZERO(A,B).EQ.0)GO TO 19
40500		X=ZERO(A,P)
40600		Y=ZERO(B,P)
40700	C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT.O1)ZERO=0
40800		S=E(KK-1)
40900		T=F(LL-1)
41000	9	IF(A-S.LT.X-O1)X=ZERO(A,S)
41100		IF(B-T.LT.Y-O1)Y=ZERO(B,T)
41200		IF(A.GT.B+O1)GO TO 8
41300		B=A
41400		KK=KK+1
41500	62	IF(X.GT.YM)GO TO 5
41600		IF(X.EQ.0)GO TO 27
41700		P=P+SM
41800	25	M=M+1
41900		G(M)=P
42000		GO TO 27
42100	5	P=P+SM
42200		IF(P)GO TO 2203
42300	C IF(P)ERROR
42400		IF(P.LT.B-O1)GO TO 5
42500		GO TO 25
42600	8	X=Y
42700		LL=LL+1
42800		GO TO 62
42900	10	M=M+1
43000		G(M)=E(KE)
43100	CC	TYPE 410,(E(K),K=1,KE)
43200	CC	TYPE 410,(F(K),K=1,KF)
43300	CC	TYPE 410,(G(K),K=1,M)
43400	CBCB	WRITE(21,410)(E(K),K=1,KE)
43500	CB	WRITE(21,410)(F(K),K=1,KF)
43600	CB	WRITE(21,410)(G(K),K=1,M)
43700	410	FORMAT(10F7.2)
43800	C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
43850	C****** NO VITAL RHYTHMS CAN PASS BAR LINES *************
43900	1033	JJ=1
44000		H(1)=0
44100		J=1
44200		K=2
44300		L=2
44400	511	IF(J.EQ.M)GO TO 911
44500		J=J+1
44600		X=G(J)
44700	1211	A=E(K)
44800		B=F(L)
44900		Y=ZERO(X,A)
45000		Z=ZERO(X,B)
45100		IF(A-B.GT.O1)GO TO 1111
45200		IF(Y.EQ.0)GO TO 1311
45300		IF(X.LT.A-O1)GO TO 1111
45400		K=K+1
45500	1411	JJ=JJ+1
45600		H(JJ)=-A
45700		GO TO 1211
45800	1111	IF(Z.EQ.0)GO TO 1311
45900		IF(X.LT.B-O1)GO TO 1311
46000		L=L+1
46100		A=B
46200		GO TO 1411
46300	
46400	1311	JJ=JJ+1
46500		H(JJ)=X
46600		IF(Y.EQ.0)GO TO 611
46700		IF(Z.EQ.0)GO TO 711
46800		IF(ZERO(A,B).EQ.0)GO TO 511
46900		P=A
47000		IF(P.GT.B+O1)GO TO 811
47100		IF(P.GT.X+O1)GO TO 511
47200		K=K+1
47300		GO TO 1011
47400	811	P=B
47500		IF(P.GT.X+O1)GO TO 511
47600		L=L+1
47700	1011	JJ=JJ+1
47800		H(JJ)=-P
47900	C NON-SPACED RHYTHS ARE NEG.
48000		GO TO 511
48100	611	K=K+1
48200		IF(Z.GT.0)GO TO 511
48300	711	L=L+1
48400		GO TO 511
48500	911	IF(HH(2).EQ.0)GO TO 2011
48600		K=2
48700		J=2
48800		L=1
48900		HHH(1)=0
49000	1511	IF(J.GT.JJ)GO TO 1811
49100		P=H(J)
49200		A=ABS(P)
49300		B=ABS(HH(K))
49400		IF(ZERO(B,A).EQ.0)GO TO 1611
49500		IF(A.GT.B)GO TO 1711
49600		J=J+1
49700		GO TO 1911
49800	1711	P=HH(K)
49900		GO TO 2211
50000	1611	J=J+1
50100	2211	K=K+1
50200	1911	L=L+1
50300		HHH(L)=P
50400		GO TO 1511
50500	2011	CALL RLOOP(HH,H,JJ)
50600		KL=JJ
50700		GO TO 2111
50800	1811	CALL RLOOP(HH,HHH,L)
50900		KL=L
51000	2111	IF(ST.GE.KPG)GO TO 1333
51100		CALL RLOOP(E,G,M)
51200		KE=M
51300	C GO WAY BACK AND READ ANOTHER LINE.
51400		GO TO 1233
51500	1333	E(1)=0
51600		GO TO 2333
51700		TYPE 410,(HH(K),K=1,KL)
51800		WRITE(21,410)(HH(K),K=1,KL)
51900	2333	JD=1
52000	C JD IS COUNTER FOR DUMMY POSITIONS.
52100		DUMMY(1)=1
52200		ST=0
52300	183	B=0
52400		LL=2
52500	
52600		DO 181 K=1,N
52700		IF(NORH(L,K))GO TO 181
52800	C LOOK FOR DUMMY RHYTHMS.
52900		IF(L.LE.2)GO TO 2184
53000		RZ=O1
53100	C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
53200		GO TO 1184
53300	2184	LF=MM(K)
53400		IF(Q(LF-1).NE.ST)GO TO 181
53500	C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
53600		J=6
53700		IF(L.EQ.2)J=4
53800		RZ=Q(LF+J)
53900	1184	B=B+RZ
54000	184	V=ABS(HH(LL))
54100		IF(ZERO(B,V).GT.0)GO TO 182
54200	C FOUND RHYTH MATCH
54300		JD=JD+1
54400		DUMMY(JD)=LL
54500		LL=LL+1
54600		GO TO 181
54700	182	IF(B.LT.V-O1)GO TO 181
54800		LL=LL+1
54900		GO TO 184
55000	181	CONTINUE
55100		ST=ST+1
55200		IF(ST.LT.KPG)GO TO 183
55300	
55400	C NEXT SORT DUMMY ARRAY
55500		J=0
55600	185	DO 186 K=2,JD
55700		IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
55800		DO 188 LL=K,JD
55900	188	DUMMY(LL-1)=DUMMY(LL)
56000		JD=JD-1
56100		GO TO 185
56200	187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
56300		CALL EXCH(DUMMY(K),DUMMY(K-1))
56400		GO TO 185
56500	186	CONTINUE
56600	C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
56700		PX=0
56800		LF=0
56900		K=1
57000		V=0
57100	
57200	81	K=K+1
57300		IF(K.GT.KL)GO TO 1433
57400		B=HH(K)
57500		A=B-V
57600		V=B
57700		IF(V)GO TO 82
57800	85	W=V
57900		IF(A.GT.O1)GO TO 89
57950	C   WAS 0.011
58000	C  .GT. BECAUSE OF ROUND-OFF ERROR   (WAS 0.01 ABOVE AND BELOW 10/79)
58100		T=5
58200		IF(HH(K+1)-V.LE.O1)T=2
58210	C   WAS 0.011
58300		PX=PX+T
58400	C THIS FOR BARS, KSIG, METER
58500		GO TO 189
58600	89	PX=PX+14.0*EXP(ALOG(A)*0.5849624)
58700	C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
58800	CC89	PX=PX+PFIBX(A)
58900	189	E(K)=PX
59000		IF(LF.NE.0)GO TO 86
59100		GO TO 81
59200	82	LF=K
59300	83	K=K+1
59400		V=HH(K)
59500		IF(V)GO TO 83
59600		A=V-W
59700		GO TO 85
59800	86	LL=LF-1
59900		D=E(K)-E(LL)
60000	87	S=-HH(LF)-HH(LL)
60100		T=HH(K)-HH(LL)
60200		T=S/T
60300	C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
60400		E(LF)=E(LL)+D*T
60500		LF=LF+1
60600		IF(LF.NE.K)GO TO 87
60700		LF=0
60800		GO TO 81
60900	
61000	1433	GO TO 2433
61100		TYPE 410,(E(K),K=1,KL)
61200		WRITE(21,410)(E(K),K=1,KL)
61300	C  5 IS SPACE AFTER 1ST BARLINE
61400	2433	IF(Q(2).EQ.18)RNEXT=RNEXT-3.6
61500	C PUSH CLOSER TO PREVIOUS BARLINE IF 1ST ITEM IS METER 
61600		R8=RNEXT
61700	C POS OF 1ST BAR = END OF PREV. LINE
61800	     	IF(ENDLN.EQ.0)RNEXT=9
61900	C  MAKES ROOM FOR 1ST CLEF.
62000		KL=KL-1
62100		J=0
62200		R5=0
62300		KK=1
62400		JD=1
62500		W=0
62600		LF=0
62700	
62800		DO 80 K=1,N
62900		IF(NORH(L,K))GO TO 80
63000		A=Q(MM(K))
63100		IF(ZERO(A,W).EQ.0)GO TO 80
63200	C  SKIP IF SAME POS OF NOTE OR REST.
63300		W=A
63400		R7=R8
63500	190	J=J+1
63600		IF(J.LE.KL)GO TO 290
63700	203	FORMAT(' FOUND CENTERED WHOLE REST!')
63800	2203	LL=0
63900		IF(JCEN.GE.0)GO TO 220
64000		TYPE 203
64100		GO TO 121
64200	220	JJJ=-1
64300		L=0
64400	120	W=LL
64500		A=0
64600		DO 124 KB=1,N
64700		LF=NN(KB)
64800		IF(LF.GT.2)GO TO 124
64900		IF(LF.LE.0)GO TO 124
65000		KE=MM(KB)
65100		IF(Q(KE-1).NE.W)GO TO 124
65200	C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
65300		JD=6
65400		IF(LF.EQ.2)JD=4
65500		A=A+Q(KE+JD)
65600	124	CONTINUE
65700		TYPE 123,LL,A
65800		LL=LL+1
65900		IF(L.EQ.0)L=A*100.+.5
66000	C  SAVE NUM. OF BEATS FIRST TIME.
66100		IF(L.NE.A*100.+.5)JJJ=0
66200	C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
66300		IF(LL.LT.KPG)GO TO 120
66400		IF(JJJ.NE.0)GO TO 121
66500		JJJ=0
66600		DO 320 KB=2,JJ
66700		A=HH(KB)-HH(KB-1)
66800		IF(A.LE.O1)GO TO 320
66900	C  SKIP BAR LINE VALUES (.01)
67000		JJJ=JJJ+1
67100		HH(JJJ)=4./A
67200	C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
67300	320	CONTINUE
67400		TYPE 420,(HH(KB),KB=1,JJJ)
67450		TYPE 421
67475	421	FORMAT(' **** COMPOSITE RHYTHM ERROR '/
67485		1 '      **** OR RHYTHM CROSSES BAR '/
67487		1 '           **** OR MISALIGNED NOTES')
67500		PAUSE
67600		GO TO 90
67800	420	FORMAT(10F8.2)
67900	123	FORMAT(' STF',I2,' =',F9.5,' QTRS')
68000	121	PAUSE' *****RHYTHM MISMATCH*****'
68100		GO TO 90
68200	290	IF(DUMMY(JD).NE.J)GO TO 190
68300		JD=JD+1
68400	90 	R8=RNEXT+E(J)
68500		R4=R5
68600		R5=A
68700		X=(R8-R7)/(R5-R4)
68800		S=R7-R4*X
68900		DO 91 L=KK,K
69000		LL=MM(L)
69100	91	Q(LL)=S+X*Q(LL)
69200		KK=K+1
69300	80	CONTINUE
69400	
69500	CCC	IF(KK.GT.K)GO TO 180
69600		IF(KK.GT.N)GO TO 180
69700	C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
69800		R7=Q(LL)-R5
69900	C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
70000	CCC	DO 280 L=KK,K
70100		DO 280 L=KK,N
70200		LL=MM(L)
70300	280	Q(LL)=R7+Q(LL)
70400	180	JJ=JJ2-2
70500		L=JJ2
70600		M=0
70700	C FLAG FOR REST AT START OF LINE
70800	
70900		JJJ=-1
71000	C FLAG FOR 1ST BAR OF LINE 12/77
71100		V=0
71200		ACCI=0
71300		DO 12 J=1,JJ
71400		   R=CODEN(KPN,J,Q,LA)
71500	CC	   IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
71600		   IF(R.EQ.4)GO TO 680
71700		   IF(M)GO TO 780
71800		   IF(R.NE.2)GO TO 780
71900	C NEXT FOR RESTS
72000		   ACCI=ACCI+.5
72100	C  ADD A LITTLE FOR TOTAL NUM. OF NOTES AND RESTS.
72200	C SHOULD WE ALSO CONSIDER CLEFS??  MAYBE ADD LATER.
72300		   IF(KBR.EQ.0)GO TO 12
72400	C  LOOK FOR RESTS AT FRONT OF LINE.
72500		   X=0
72600		   CALL TURN(J,JJ,1,X)
72700		   PGTRN(KBR)=PGTRN(KBR)+X
72800		   M=-1
72900		   
73000	780	   IF(R.NE.1)GO TO 12
73100		   IF(V.NE.Q(LA+3))GO TO 782
73200	           IF(JACC)GO TO 781
73300	782	   ACCI=ACCI+.5
73400	   	   IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
73500		   JACC=-1
73600		   V=1
73700	C KPG=NUMB. OF STAVES BEING CONSIDERED. (IF 1, THEN ALL ACCIS ARE 'BIG')
73800		   IF(KPG.GT.1)V=RSTFAC(IFIX(Q(LA+2))+1)
73900	CCCC	V=RSTFAC(IFIX(Q(LA+2))+1)
74000	CC	ACCI=ACCI+ACCISZ*RSTFAC(IFIX(Q(LA+2)))
74100	CCCC	ACCI=ACCI+ACCISZ*V
74200	  	   ACCI=ACCI+V
74300	C  ADD SPACE FOR ACCIDENTALS*STAFF SIZE -- SEE DATA FOR ACCISZ.
74400		   V=Q(LA+3)
74500	781	   M=-1
74600		   IF(NOGRCE)GO TO 12
74700	C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
74800	C FOUND A NOTE
74900	C*************************	   IF(Q(LA+9).GT.0.05)GO TO 12 
75000		IF(Q(LA+9).NE.4.0/88.0)GO TO 12
75100	C JUMP IF NOT A GRACE NOTE
75200		   R=Q(LA+2)
75300	C  THE STAFF NUM.
75400		   DO 580 LF=J+1,JJ
75500		   	IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
75600			IF(Q(JD+2).NE.R)GO TO 580
75700		   	IF(Q(JD).LT.7)GO TO 580
75800		   	IF(Q(JD+9).EQ.0)GO TO 580
75900	C   CHORD NOTE
76000	  	   	R4=Q(LA+3) 
76100	CC	   	R4=Q(LA+3)-1 
76200		   	R5=Q(JD+3)
76300	C  THE STAFF # IS IN R2
76400		   	R8=RSTFAC(IFIX(R2+1))+.5
76500		   	IF(Q(JD+4).LT.80)R8=R8*2  
76600	C  INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
76700		   	R8=R5-R8
76800	CC	   	R8=R5-R8-1
76900	CCC	   	IF(R4.EQ.R5)GO TO 12
77000		   	IF(R4.NE.R5)GO TO 480
77100	C  GRACE NOTE AT START OF LINE ***** FIX THIS????
77200			DO 880 KE=1,LF-1
77300	880		Q(KPN(KE)+3)=R8
77400	C  MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
77500		   	GO TO 12
77600	480	   	R2=Q(LA+2)
77700		   	R9=R5
77800		   	CALL PTMOVE(Q,KPN)
77900	CC	   	TYPE 9999,Q(J+3),Q(JD+3)
78000	CC9999	   	FORMAT(2F)
78100		   	GO TO 12 
78200	580	   CONTINUE
78300		   GO TO 12
78400	C  ABOVE FOR GRACE NOTE SPACING.
78500	680	   KBR=KBR+1
78600	C BAR LINE COUNTER
78700		   T=Q(LA+3)
78800	C TOTAL SPACE
78900		   X=0
79000		   CALL TURN(J-1,1,-1,X)
79100		   CALL TURN(J+1,JJ,1,X)
79200	222	   PGTRN(KBR)=X
79300	C FINDS PAGE-TURN POSSIBILITIES
79400	C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
79500		   BFAC=.8
79600	CCC	   BFAC=.756
79700		   IF(KPG.GT.1)CALL BARFAC(KPG,BFAC,JK)
79800	CC	   IF(KPG.LE.1)GO TO 3112
79900	C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
80000	CC	   R=RSTFAC(1)
80100	CC	   DO 5112 K=2,KPG
80200	CC5112	   IF(R.NE.RSTFAC(K))GO TO 6112
80300	CC	   GO TO 3112
80400	C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
80500	C  FIND LINE WITH MOST ACTIVITY.
80600	C  ALL THIS SORT OF WORKS.  SOMEDAY REVIEW IT.********
80700	CC6112	   DO 1112 K=1,8
80800	CC1112	   RN(K)=0
80900	CC	   DO 112 K=JK,J-1
81000	CC	   R=CODEN(KPN,K,Q,JD)
81100	CC	   IF(R.GT.3.)GO TO 112
81200	CC	   A=1.0
81300	C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
81400	CC	   IF(R.EQ.2)A=0.6
81500	C SKIP NON-RHYTHM CHORD NOTES.   RESTS ARE CONSIDERED LESS IMPORTANT.
81600	CC	   IF(R.NE.1)GO TO 4112
81700	CC	   IF(Q(JD).LT.7)GO TO 112
81800	CC	   IF(Q(JD+9).LE.0)GO TO 112
81900	CC4112	   LF=Q(JD+2)+1
82000	CC	   RN(LF)=RN(LF)+A 
82100	CC112	   CONTINUE
82200	CC	   JD=1
82300	CC	   B=RN(1)*RSTFAC(1)
82400	CC	   DO 2112 K=2,8
82500	CC	   A=RN(K)*RSTFAC(K)
82600	CC  	   IF(A.LE.B)GO TO 2112
82700	CC	   JD=K
82800	CC	   B=A
82900	CC2112	   CONTINUE
83000	CC	   BFAC=BFAC*(RSTFAC(JD)+.1)
83100	C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
83200	CXX	   BFAC=.84*RSTFAC(JD)
83300	3112	   IF(JJJ)RNEXT=RNEXT-6
83400	C JJJ=-1 IF 1ST BAR OF LINE. 12/77
83500		   JJJ=0
83600		   BARS(KBR)=(T-RNEXT+ACCI)*BFAC
83700	C SIZE OF THIS MEASURE + ACCISZ*ACCIDENTALS
83800		   ACCI=0
83900	C RESET ACCI (SPACE FOR ACCIS AND TOTAL NUM. OF NOTES)
84000		   K=J
84100		   JK=J+1
84200	C SET UP POINTER FOR NEXT BAR'S ITEMS.
84300		   RNEXT=T
84400	12	CONTINUE
84500	
84600		IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
84700		RNEXT=RNEXT+5
84800	CCC 11/9/78	RNEXT=RNEXT+3
84900		JJ2=L 
85000	C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
85100	CC???380	LCNT=0
85200	CC???	NDPY=0
85300	
85400	C JJ2 IS END OF PNTR DATA
85500	11	IF(IPG.EQ.2)NMPG=NAMX
85600	C IPG=2=REORDER INPUT FILE ONLY.
85705	C WHY DID I WRITE 2 EXTRA WORDS AT END OF Q ARRAY. (MAYBE NEEDED∞
85707	C  BUT IF 1ST EXTRA WAS NEG. (OR ZER0?) CAUSED BUG IN NEW 'INUMS' ROUTINE.
85710		JPQ=KPN(JJ2-1)+1
85720		Q(JPQ-1)=0
85800		CALL PUTEXT(NMPG,'PAG')
85900		CALL EXTOUT(RSTFAC,128)
86000	C*** 	CALL EXTOUT(PN,JJ2)
86100	C NEW SAVE FORMAT DOESN'T NEED ABOVE 3/80
86200		CALL EXTOUT(Q,JPQ)
86300		IF(IPG.EQ.2)CALL EXIT
86400		CALL FINEXT
86500	
86600		LASTNM=NMPG
86700		NMPG=NMPG+2
86800		IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
86900	C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
87000		IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
87100		IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
87200	122	ENDLN=RNEXT
87300		END